perm filename CMPEXP.FMT[LSP,LSP] blob sn#337904 filedate 1978-03-01 generic text, type T, neo UTF8
(DFUNC (COMPOSEXPR EXPR WIDTH RPARS SLACK)
 (PROG (FIRST MARG PLATE REST TEM)
       (SETQ COMPOSEXPRCOUNT (ADD1 COMPOSEXPRCOUNT))
       (SETQ PLATE (SETEXPR (CLEANPLATE) EXPR))
       (COND (ATOM EXPR) (NOT (GREATERP (PLUS (COLUMN PLATE) RPARS) WIDTH)))
       (COND ((AND (ATOM (CAR EXPR)) (NOT (NUMBERP (CAR EXPR))) (SETQ TEM (GETGET (CAR EXPR) (Q EXPRFORM))))
	      (RETURN ((PROPVAL TEM) EXPR WIDTH RPARS SLACK))))
       (SETQ PLATE (SETLPR (CLEANPLATE)))
       (COND (SETRPR (SETLIST PLATE 1 (COMPOSLIST EXPR (SUB1 WIDTH) (ADD1 RPARS) SLACK))))
       (SETQ FIRST (COMPOSEXPR (CAR EXPR) (SUB1 WIDTH) 0 SLACK))
       (SETQ MARG (PLUS (COLUMN FIRST) 2))
       (COND ((ATOM (CAR EXPR))
	      (SETQ REST1 (COMPOSLIST (CDR EXPR) (SUB1 WIDTH) (ADD1 RPARS) (PLUS SLACK (SUB1 MARG))))
	      (COND ((NOT (LESSP (DIFFERENCE WIDTH MARG) (FULLWIDTH REST1 (ADD1 RPARS))))
		     (SETQ PLATE (SETLIST (SETEXPR PLATE (CAR EXPR)) MARG REST1)))
		    (T (SETQ REST (COMPOSLIST (CDR EXPR) (DIFFERENCE WIDTH MARG) (ADD1 RPARS) (PLUS SLACK (SUB1 MARG))))
		       (COND ((LESSP (PLUS SLACK (DIFFERENCE WIDTH MARG)) (FULLWTH REST (ADD1 RPARS)))
			      (SETQ SLACKCOUNT (ADD1 SLACKCOUNT))
			      (SETQ PLATE (SETLIST (SETEXPR PLATE (CAR EXPR))
						   1
						   (COMPOSLIST (CDR EXPR) (SUB1 WIDTH) (ADD1 RPARS) SLACK))))
			     (T	(COND ((LESSP (HEIGHT REST1) (SUB1 (HEIGHT REST)))
				       (SETQ PLATE (SETLIST (SETEXPR PLATE (CAR EXPR)) MARG REST)))
				      (T (SETQ PLATE (SETLIST (SETEXPR PLATE (CAR EXPR)) 1 REST1)))))))))
	     (T	(SETQ REST (COMPOSLIST (CDR EXPR) (SUB1 WIDTH) (ADD1 RPARS) SLACK))
		(COND ((OR (GREATERP (HEIGHT FIRST) 1) (LESSP (DIFFERENCE WIDTH MARG) (FULLWTH REST (ADD1 RPARS))))
		       (SETQ PLATE (SETLIST PLATE 1 (SETPLATE FIRST REST))))
		      (T (SETQ PLATE (SETLIST (SETEXPR PLATE (CAR EXPR)) MARG REST))))))
       (COND ((GREATERP (SETQ ELONG (QUOTIENT (PLUS (HEIGHT PLATE) 0.0) (PLUS (WIDTH PLATE) 0.0))) MAXELONG)
	      (SETQ ATOMCOUNT (ADD1 ATOMCOUNT))
	      (COND (NEWFEAT (SETQ PLATE (SETLIST (SETLPR (CLEANPLATE))
						  1
						  (COMPOSATOMS EXPR (SUB1 WIDTH) (ADD1 RPARS) SLACK)))))))
       (RETURN (SETRPR PLATE))))